home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The X-Philes (2nd Revision)
/
The X-Philes Number 1 (1995).iso
/
xphiles
/
hp48hor1
/
phone5.src
< prev
next >
Wrap
Text File
|
1991-10-19
|
4KB
|
228 lines
%%HP: T(3)A(D)F(.);
@ PHONE, by Robert K. Brunner
DIR
FILES
DIR
CARDS
\<< RCWS 64
STWS RCLF ROT
IF DUP
VTYPE -1 ==
THEN DUP
{ } SWAP STO
END CVIEW
STOF STWS
\>>
END
CVIEW
\<< DUP RCL DUP
SIZE ROT 1 DUP DUP
0 DUP DUP DUP \->
imax fnm i jmax j
ti tx txi txl
\<< { "ADD"
"EDIT" "DEL" "FIND"
"SAVE" "QUIT" }
TMENU 11 SF 10 CF
DO
IF imax
THEN
IF 11
FS?C
THEN
CLLCD DUP i cGET
'jmax' STO 'txl'
STO 'txi' STO 'tx'
STO DUP 1 DISP 'ti'
STO
END tx
txi j txl ROT ROT
GET SWAP SUB 2 DISP
ELSE
CLLCD "Empty file"
2 DISP 11 CF 0
'jmax' STO
END -1
WAIT
CASE DUP
25.1 ==
THEN
IF j
1 >
THEN
'j' DECR DROP
ELSE
eBEEP
END
END DUP
35.1 ==
THEN
IF j
5 + jmax <
THEN
'j' INCR DROP
ELSE
eBEEP
END
END DUP
34.1 ==
THEN
IF i
1 >
THEN
1 'j' STO 'i' DECR
DROP 11 SF
ELSE
eBEEP
END
END DUP
36.1 ==
THEN
IF i
imax <
THEN
1 'j' STO 'i' INCR
DROP 11 SF
ELSE
eBEEP
END
END DUP
11.1 ==
THEN
DROP icADD 'i' STO
11 SF 'imax' INCR
END DUP
12.1 ==
THEN
IF
imax
THEN
DROP i icED 11 SF 0
ELSE
eBEEP
END
END DUP
13.1 ==
THEN
IF
imax
THEN
DROP i cDEL 1 'j'
STO 'imax' DECR
IF i <
THEN 'i' DECR
ELSE 0
END 11 SF
ELSE
eBEEP
END
END DUP
14.1 ==
THEN
IF
imax
THEN
DROP DUP "Title:" {
\Ga } INPUT cFIND
IF DUP imax <
THEN 1 +
END 'i' STO 11 SF 0
ELSE
eBEEP
END
END DUP
15.1 ==
THEN
DROP DUP fnm STO 0
END DUP
16.1 ==
THEN 10
SF
END
END DROP
UNTIL 10
FS?
END DROP 0
MENU
\>>
\>>
icADD
\<< DUP SIZE
"Title:" { \Ga }
INPUT DUP ":" + { \Ga
} INPUT \-> tit tx
\<<
IF NOT
THEN 0
ELSE DUP
tit cFIND
END SWAP
OVER tit tx 2 \->LIST
cADD SWAP 1 +
\>>
\>>
icED
\<< \-> i
\<< DUP i GET
DUP OBJ\-> DROP SWAP
":" + SWAP { \Ga } +
INPUT 2 SWAP PUT i
SWAP PUT
\>>
\>>
eBEEP
\<< 440 .1 BEEP
\>>
cGET
\<< GET OBJ\-> DROP
SWAP ":" + SWAP DUP
DUP SIZE { 1 } \-> sz
txi
\<<
WHILE DUP
"
" POS DUP
REPEAT SWAP
OVER " " REPL SWAP
1 + 'txi' SWAP STO+
END DROP2
txi sz OVER SIZE
\>>
\>>
cADD
\<< \-> i new
\<< OBJ\-> \-> n
\<< new 'n'
INCR i - ROLLD n
\->LIST
\>>
\>>
\>>
cFIND
\<< \-> str
\<< { "" } SWAP
OBJ\-> DUP \-> n i
\<<
IF n
THEN
WHILE 1
GET str \>= i AND
REPEAT
'i' DECR DROP
END
END i
DROPN i
\>>
\>>
\>>
cDEL
\<< \-> i
\<< OBJ\-> \-> n
\<< n i - 1 +
ROLL DROP n 1 -
\->LIST
\>>
\>>
\>>
END